1 Einleitung

Die Daten stammen aus dem FIS-Broker der Senatsverwaltung für Stadtentwicklung und Wohnen.

Zur Arbeit mit dem FIS-Broker siehe auch den Vortrag “Daten aus dem FIS-Broker” von Jochen Klar zum ODD 2017 in Berlin.

2 Setup

library(gdalUtils)
library(ggplot2)
suppressPackageStartupMessages(library(dplyr))
library(leaflet)
suppressPackageStartupMessages(library(viridis))
library(tibble)
library(scales)
## 
## Attaching package: 'scales'
## The following object is masked from 'package:viridis':
## 
##     viridis_pal
library(sf)
## Linking to GEOS 3.6.1, GDAL 2.2.0, proj.4 4.9.3
library(purrr)
## 
## Attaching package: 'purrr'
## The following object is masked from 'package:scales':
## 
##     discard
library(glue)
## 
## Attaching package: 'glue'
## The following object is masked from 'package:dplyr':
## 
##     collapse
library(ggridges)

knitr::opts_chunk$set(echo = TRUE)

options(width = 140, stringsAsFactors = FALSE)

3 

dat <- purrr::map(2002:2018, ~{
        Sys.sleep(2)
        url <- glue::glue("http://fbinter.stadt-berlin.de/fb/wfs/geometry/senstadt/re_brw{.}?service=wfs&version=2.0.0&request=GetFeature&TYPENAMES=re_brw{.}&outputFormat=application/geo%2Bjson")
        sf::read_sf(url) %>% sf::st_transform(., 4326)
  })

saveRDS(dat, file = "./data/brwdata.rds")
dat <- purrr::map(dat, function(year) { 
           year %>%
            filter(id != "0", BEZIRK != "") %>%
            select(id, BEZIRK, BRW, 
                   NUTZUNG, STICHTAG, GFZ, BEITRAGSZUSTAND, geometry) %>% 
            mutate(id = as.integer(id),
                   BRW = as.integer(BRW), 
                   GFZ = as.numeric(GFZ),
                   STICHTAG = as.Date(STICHTAG),
                   year = as.numeric(format(as.Date(STICHTAG), "%Y")))
          })

dat <- do.call("rbind", dat)

dat <- dat %>% arrange(id, year)

class(dat)
## [1] "sf"         "tbl_df"     "tbl"        "data.frame"
glimpse(dat, width = 110)
## Observations: 18,438
## Variables: 9
## $ id              <int> 1000, 1000, 1000, 1000, 1000, 1001, 1001, 1001, 1001, 1001, 1001, 1001, 1001, 100...
## $ BEZIRK          <chr> "Marzahn-Hellersdorf", "Marzahn-Hellersdorf", "Marzahn-Hellersdorf", "Marzahn-Hel...
## $ BRW             <int> 160, 140, 120, 100, 80, 180, 160, 140, 120, 120, 120, 120, 120, 120, 120, 120, 22...
## $ NUTZUNG         <chr> "G - Gewerbe", "G - Gewerbe", "G - Gewerbe", "G - Gewerbe", "G - Gewerbe", "W - W...
## $ STICHTAG        <date> 2002-01-01, 2003-01-01, 2004-01-01, 2005-01-01, 2007-01-01, 2002-01-01, 2003-01-...
## $ GFZ             <dbl> NA, NA, NA, NA, NA, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0...
## $ BEITRAGSZUSTAND <chr> "Beitragsfrei nach BauGB", "Beitragsfrei nach BauGB", "Beitragsfrei nach BauGB", ...
## $ year            <dbl> 2002, 2003, 2004, 2005, 2007, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 201...
## $ geometry        <sf_geometry [degree]> MULTIPOLYGON (((13.55866 52..., MULTIPOLYGON (((13.55824 52..., ...

4 Zuordnung der Wohnlage im Jahr 2017

wl_gr <- c("M", "E", "G", "E/M", "M/E", "G/M", "G/E", "M/G", "E/G")

match_WL <- function(x, y) { 
                      z <- sum(match(c(x,y), wl_gr), na.rm = TRUE)
                      z <- ifelse(z == 0, NA, z)
                      z }

wl <- readr::read_tsv("tabula-brw-liste-geschlossene-bauweise-2017.tsv", 
                      col_names = FALSE, skip= 1) %>%
        select(X1, X6, X7) %>%
        filter(!is.na(X1), X1 != "GFZ") %>%
        purrr::set_names(c("id", "WL_A", "WL_B")) %>%  
        mutate(id = as.numeric(id)) %>%  
        rowwise() %>%
        mutate(Wohnlage = match_WL(WL_A, WL_B),
               Wohnlage = wl_gr[Wohnlage]) %>%
        select(id, Wohnlage) %>%
        arrange(id)
## Parsed with column specification:
## cols(
##   X1 = col_character(),
##   X2 = col_character(),
##   X3 = col_character(),
##   X4 = col_character(),
##   X5 = col_character(),
##   X6 = col_character(),
##   X7 = col_character(),
##   X8 = col_character(),
##   X9 = col_character(),
##   X10 = col_character(),
##   X11 = col_character(),
##   X12 = col_character(),
##   X13 = col_character(),
##   X14 = col_character()
## )
## Warning: 243 parsing failures.
## row col   expected     actual                                              file
##  15  -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
##  16  -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
##  17  -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
##  18  -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
##  19  -- 14 columns 13 columns 'tabula-brw-liste-geschlossene-bauweise-2017.tsv'
## ... ... .......... .......... .................................................
## See problems(...) for more details.
dat <- left_join(dat, wl, by = "id")
table(dat$GFZ, dat$Wohnlage) %>% knitr::kable()
E E/G E/M G G/E G/M M M/E M/G
0.1 0 0 0 0 0 0 0 0 0
0.2 0 0 0 0 0 0 0 0 0
0.3 0 0 0 0 0 0 0 0 0
0.4 0 0 0 0 0 0 0 0 0
0.5 0 0 0 0 0 0 0 0 0
0.6 0 0 0 0 0 0 0 0 0
0.7 25 0 0 0 0 0 94 0 0
0.8 76 17 27 91 0 17 140 16 0
0.9 17 0 9 0 0 0 0 0 0
1 290 0 102 203 17 63 520 126 0
1.2 34 0 8 68 0 17 154 62 0
1.3 17 0 8 17 0 0 59 0 0
1.5 49 0 68 17 0 0 206 77 17
1.6 0 0 0 0 0 0 17 0 0
1.7 0 0 0 0 0 0 0 0 0
1.8 0 0 0 0 0 0 0 0 0
2 187 0 51 51 0 35 146 24 11
2.4 0 0 0 0 0 0 0 0 0
2.5 220 0 51 17 0 0 45 27 16
2.7 15 0 0 0 0 0 0 0 0
3 17 0 0 0 0 0 17 0 0
3.5 0 0 0 0 0 0 0 0 0
4 0 0 0 0 0 0 0 0 0
4.5 0 0 0 0 0 0 17 0 0

5 Anzahl der Bodenrichtwertzonen nach Bezirken

  table(dat$BEZIRK, dat$year) %>% knitr::kable()
2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018
Charlottenburg-Wilmersdorf 70 70 70 74 70 78 76 77 76 78 79 81 80 80 81 81 81
Friedrichshain-Kreuzberg 44 43 42 44 37 37 38 41 44 40 39 37 36 36 33 34 34
Lichtenberg 75 74 72 73 70 71 71 71 72 73 75 82 83 83 82 81 82
Marzahn-Hellersdorf 46 49 49 48 48 52 55 56 55 56 58 57 57 58 57 57 57
Mitte 92 92 93 91 80 84 89 89 95 90 91 92 95 91 91 94 95
Neukölln 59 59 59 61 60 60 60 63 62 62 63 64 64 64 64 64 64
Pankow 122 122 121 122 121 112 118 126 129 126 123 131 135 131 128 127 126
Reinickendorf 95 95 93 92 92 97 96 98 97 100 99 108 106 104 103 104 104
Spandau 122 122 125 124 122 125 129 131 130 137 139 147 148 149 149 147 148
Steglitz-Zehlendorf 112 112 114 114 106 113 114 116 115 122 121 125 126 125 125 127 126
Tempelhof-Schöneberg 69 69 68 68 61 69 69 72 71 70 70 73 74 72 73 74 74
Treptow-Köpenick 128 129 128 127 131 131 135 131 141 141 142 158 161 154 152 154 155

6 Anzahl der Bodenrichtwertzonen nach Art der Nutzung

 table(dat$NUTZUNG, dat$year) %>% knitr::kable()
2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018
F - Forstflächen 0 0 0 0 0 0 0 0 0 0 0 35 35 35 35 35 35
G - Gewerbe 234 234 234 228 234 242 243 253 244 238 238 236 235 227 224 223 221
GB - Gemeinbedarf 0 0 0 0 0 0 0 0 0 34 35 37 38 39 39 39 40
Gp - Gewerbe produzierend 18 18 17 18 15 10 9 0 10 7 6 4 4 4 4 4 4
LW-A - Acker 0 0 0 0 0 0 0 0 0 0 0 10 10 11 11 11 11
LW-EGA - Erwerbsgartenbau 0 0 0 0 0 0 0 0 0 0 0 4 4 3 3 3 3
LW-G - Grünland 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 0 0
LW-GR - Grünland 0 0 0 0 0 0 0 0 0 0 0 0 6 6 6 6 6
M1 - Kerngebiet 54 54 54 52 35 49 52 52 57 54 54 56 59 55 53 53 53
M1* - Einzelhandelszentrum 0 0 0 0 12 14 15 15 15 16 16 15 15 15 8 8 8
M2 - Mischgebiet 48 49 50 48 19 43 43 43 46 44 45 43 41 39 37 39 37
W - Wohngebiet 680 681 679 692 683 671 688 708 715 702 705 709 718 713 718 723 728

7 Berechnung von Kennzahlen

# https://github.com/r-spatial/sf/issues/518
dat <- dat %>% st_buffer(0)
## Warning in st_buffer.sfc(st_geometry(x), dist, nQuadSegs): st_buffer does not correctly buffer longitude/latitude data
## dist is assumed to be in decimal degrees (arc_degrees).
z <- tbl_df(dat) %>% 
        group_by(BEZIRK, NUTZUNG, GFZ, year) %>% 
        summarise(count = n(),
                  q25 = quantile(BRW, 0.25, na.rm = TRUE),
                  q75 = quantile(BRW, 0.75, na.rm = TRUE),
                  q95 = quantile(BRW, 0.95, na.rm = TRUE),
                  iqr = IQR(BRW, na.rm = TRUE),
                  mean = mean(BRW, na.rm = TRUE),
                  med = median(BRW, na.rm = TRUE)) %>%
        ungroup()

8 In der Nutzung W - Wohngebiet

p0 <- ggplot(filter(z, year >= 2008, NUTZUNG == "W - Wohngebiet"),
       aes(factor(year), mean, colour = "BEZIRK", group = "BEZIRK")) +
      geom_line() +
      facet_grid(factor(GFZ) ~ BEZIRK, scales = "free") +
      theme(axis.text.x  = element_text(angle=90, vjust=0.5, size = 8),
            axis.text.y  = element_text(size = 8), 
            legend.position="none") +
      labs(x = "",
           y = "Durchschnitt in  €",
           title = "Bodenrichtwerte in der Nutzung 'W - Wohngebiet' (2008-2018)",
           subtitle = "",
           caption = "Quelle: FIS-Broker / Gutachterausschuss für Grundstückswerte in Berlin")
p0

9 In der Nutzung M2 - Mischgebiet

p1 <- ggplot(filter(z, year >= 2008, NUTZUNG == "M2 - Mischgebiet"),
       aes(factor(year), mean, colour = "BEZIRK", group = "BEZIRK")) +
      geom_line() +
      facet_grid(factor(GFZ) ~ BEZIRK, scales = "free") +
      theme(axis.text.x  = element_text(angle=90, vjust=0.5, size = 8),
            axis.text.y  = element_text(size = 8),
            legend.position="none") +
      labs(x = "",
           y = "Durchschnitt in €",
           title = "Bodenrichtwerte in der Nutzung 'M2 - Mischgebiet' (2008-2018)",
           subtitle = "",
           caption = "Quelle: FIS-Broker / Gutachterausschuss für Grundstückswerte in Berlin")
p1

10 Karte der Bodenrichtwerte im Jahr 2018 - BRW <= 8.000

brw <- dat %>%
       filter(year == 2018, BRW <= 8000)

pal <- colorNumeric(
  palette = viridis_pal()(10),
  domain = brw$BRW
)

popup <- paste0("<b>", brw$id, " - ",
                       brw$NUTZUNG , " - ",
                       brw$GFZ, " - ", 
                       brw$BRW, " Euro/qm")

leafMap <- leaflet(height = "800px", width = "1000px") %>%
  setView(lng = 13.383, lat = 52.516, zoom = 11) %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  addPolygons(data = brw,
              stroke = TRUE,
              dashArray = 1,
              weight = 1.5,
              color = "white",
              smoothFactor = 0.20,
              fillOpacity = 0.60,
              fillColor = ~pal(brw$BRW),
              highlightOptions = highlightOptions(color = "steelblue", 
                                                  weight = 4,
                                                  bringToFront = FALSE),
              popup = popup,
              group = "Bodenrichtwerte") %>%
  addLegend("bottomright",
            pal = pal,
            values = brw$BRW,
            title = "Euro/qm",
            labFormat = labelFormat(suffix = " "),
            opacity = 1)

leafMap

11 Verteilung der BRW nach GFZ

Vorlage der Grafik ist Mapping San Francisco home prices using R

WIP!

p1 <- filter(dat, 
             NUTZUNG == "W - Wohngebiet", 
             GFZ %in% c(0.2, 0.4, 0.6, 1, 1.2, 2.0, 2.5) )

p1 <- p1[which(p1$BRW < mean(p1$BRW) + (2.5 * sd(p1$BRW))), ]

brw_violin <- ggplot(p1, aes(x=factor(year), y=BRW, fill=factor(year))) + 
              geom_violin(color = "grey50") +
              stat_summary(fun.y=mean, geom="point", size=2, colour="white") +
              stat_summary(fun.y=median, geom="point", size=2, colour="red") + 
              facet_wrap( ~ GFZ, ncol = 2, scales = "free") + 
              theme(legend.position="none") +
              scale_y_continuous(labels = comma) +
              labs(x="",
                   y="Bodenrichtwert(€)",
                   title="Verteilung der Bodenrichtwerte (W-Wohngebiet) nach ausgewählter GFZ",
                   subtitle="Nominal prices (2002 - 2018); BRW means visualized as points, median in red",
                   caption="Quelle: FIS-Broker / Gutachterausschuss für Grundstückswerte in Berlin")

brw_violin

12 Ridgeline plot

p2 <- dplyr::filter(dat, NUTZUNG == "W - Wohngebiet", BRW <= 3000)

brw_ridgeline <- ggplot(p2, aes(x = BRW, y = factor(year))) + 
                 geom_density_ridges(scale = 3, rel_min_height = 0.01) + 
                 theme_ridges(font_size = 11, grid = TRUE) +
                 labs(x="Bodenrichtwert (€)",
                      y="year",
                      title="Verteilung der Bodenrichtwerte (W-Wohngebiet), BRW <= 3000",
                      subtitle="Nominal prices (2002 - 2018)",
                      caption="Quelle: FIS-Broker / Gutachterausschuss für Grundstückswerte in Berlin")

brw_ridgeline
## Picking joint bandwidth of 36.6

13 Session Info

devtools::session_info()
## Session info ------------------------------------------------------------------------------------------------------------------------------
##  setting  value                                      
##  version  R version 3.4.3 Patched (2017-12-05 r73849)
##  system   x86_64, mingw32                            
##  ui       RTerm                                      
##  language (EN)                                       
##  collate  German_Germany.1252                        
##  tz       Europe/Berlin                              
##  date     2018-03-09
## Packages ----------------------------------------------------------------------------------------------------------------------------------
##  package     * version    date       source                                 
##  assertthat    0.2.0      2017-04-11 CRAN (R 3.4.3)                         
##  backports     1.1.2      2017-12-13 CRAN (R 3.4.3)                         
##  base        * 3.4.3      2017-12-06 local                                  
##  bindr         0.1        2016-11-13 CRAN (R 3.4.3)                         
##  bindrcpp    * 0.2        2017-06-17 CRAN (R 3.4.3)                         
##  class         7.3-14     2015-08-30 CRAN (R 3.4.3)                         
##  classInt      0.1-24     2017-04-16 CRAN (R 3.4.3)                         
##  codetools     0.2-15     2016-10-05 CRAN (R 3.4.3)                         
##  colorspace    1.3-2      2016-12-14 CRAN (R 3.4.3)                         
##  compiler      3.4.3      2017-12-06 local                                  
##  crosstalk     1.0.0      2016-12-21 CRAN (R 3.4.3)                         
##  datasets    * 3.4.3      2017-12-06 local                                  
##  DBI           0.7        2017-06-18 CRAN (R 3.4.3)                         
##  devtools      1.13.4     2017-11-09 CRAN (R 3.4.3)                         
##  digest        0.6.15     2018-01-28 CRAN (R 3.4.3)                         
##  dplyr       * 0.7.4      2017-09-28 CRAN (R 3.4.3)                         
##  e1071         1.6-8      2017-02-02 CRAN (R 3.4.3)                         
##  evaluate      0.10.1     2017-06-24 CRAN (R 3.4.3)                         
##  foreach       1.4.4      2017-12-12 CRAN (R 3.4.3)                         
##  gdalUtils   * 2.0.1.7    2015-10-10 CRAN (R 3.4.3)                         
##  ggplot2     * 2.2.1.9000 2018-02-04 Github (tidyverse/ggplot2@a2dc248)     
##  ggridges    * 0.4.1      2017-09-15 CRAN (R 3.4.3)                         
##  glue        * 1.2.0      2017-10-29 CRAN (R 3.4.3)                         
##  graphics    * 3.4.3      2017-12-06 local                                  
##  grDevices   * 3.4.3      2017-12-06 local                                  
##  grid          3.4.3      2017-12-06 local                                  
##  gridExtra     2.3        2017-09-09 CRAN (R 3.4.3)                         
##  gtable        0.2.0      2016-02-26 CRAN (R 3.4.3)                         
##  highr         0.6        2016-05-09 CRAN (R 3.4.3)                         
##  hms           0.4.0      2017-11-23 CRAN (R 3.4.3)                         
##  htmltools     0.3.6      2017-04-28 CRAN (R 3.4.3)                         
##  htmlwidgets   0.9        2017-12-07 Github (ramnathv/htmlwidgets@c9a9684)  
##  httpuv        1.3.5      2017-07-04 CRAN (R 3.4.3)                         
##  iterators     1.0.9      2017-12-12 CRAN (R 3.4.3)                         
##  jsonlite      1.5        2017-06-01 CRAN (R 3.4.3)                         
##  knitr         1.18       2017-12-27 CRAN (R 3.4.3)                         
##  labeling      0.3        2014-08-23 CRAN (R 3.4.1)                         
##  lattice       0.20-35    2017-03-25 CRAN (R 3.4.3)                         
##  lazyeval      0.2.1      2017-10-29 CRAN (R 3.4.3)                         
##  leaflet     * 1.1.0.9000 2017-12-07 Github (rstudio/leaflet@d489e2c)       
##  magrittr      1.5        2014-11-22 CRAN (R 3.4.3)                         
##  memoise       1.1.0      2017-04-21 CRAN (R 3.4.3)                         
##  methods     * 3.4.3      2017-12-06 local                                  
##  mime          0.5        2016-07-07 CRAN (R 3.4.1)                         
##  munsell       0.4.3      2016-02-13 CRAN (R 3.4.3)                         
##  pillar        1.1.0      2018-01-14 CRAN (R 3.4.3)                         
##  pkgconfig     2.0.1      2017-03-21 CRAN (R 3.4.3)                         
##  plyr          1.8.4      2016-06-08 CRAN (R 3.4.3)                         
##  purrr       * 0.2.4      2017-10-18 CRAN (R 3.4.3)                         
##  R.methodsS3   1.7.1      2016-02-16 CRAN (R 3.4.1)                         
##  R.oo          1.21.0     2016-11-01 CRAN (R 3.4.1)                         
##  R.utils       2.6.0      2017-11-05 CRAN (R 3.4.3)                         
##  R6            2.2.2      2017-06-17 CRAN (R 3.4.3)                         
##  raster        2.6-7      2017-11-13 CRAN (R 3.4.3)                         
##  Rcpp          0.12.14    2017-11-23 CRAN (R 3.4.3)                         
##  readr         1.1.1.9000 2017-12-07 Github (hadley/readr@af1a969)          
##  reshape2      1.4.3      2017-12-11 CRAN (R 3.4.3)                         
##  rgdal         1.2-16     2017-11-21 CRAN (R 3.4.3)                         
##  rlang         0.1.6.9003 2018-02-04 Github (tidyverse/rlang@c6747f9)       
##  rmarkdown     1.8.5      2018-01-10 Github (rstudio/rmarkdown@d0109f4)     
##  rprojroot     1.3-2      2018-01-03 CRAN (R 3.4.3)                         
##  scales      * 0.5.0.9000 2017-12-07 Github (hadley/scales@d767915)         
##  sf          * 0.6-0      2018-01-06 CRAN (R 3.4.3)                         
##  shiny         1.0.5      2017-08-23 CRAN (R 3.4.3)                         
##  sp            1.2-6      2018-01-05 CRAN (R 3.4.3)                         
##  stats       * 3.4.3      2017-12-06 local                                  
##  stringi       1.1.6      2017-11-17 CRAN (R 3.4.2)                         
##  stringr       1.2.0      2017-02-18 CRAN (R 3.4.3)                         
##  tibble      * 1.4.2      2018-01-22 CRAN (R 3.4.3)                         
##  tools         3.4.3      2017-12-06 local                                  
##  udunits2      0.13       2016-11-17 CRAN (R 3.4.1)                         
##  units         0.5-1      2018-01-08 CRAN (R 3.4.3)                         
##  utils       * 3.4.3      2017-12-06 local                                  
##  viridis     * 0.4.1      2018-01-08 CRAN (R 3.4.3)                         
##  viridisLite * 0.3.0      2018-02-04 Github (sjmgarnier/viridisLite@91199d1)
##  withr         2.1.1.9000 2018-01-01 Github (jimhester/withr@df18523)       
##  xtable        1.8-2      2016-02-05 CRAN (R 3.4.3)                         
##  yaml          2.1.16     2017-12-12 CRAN (R 3.4.3)